home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / TOT / DEMO.EXE / arc / TELE.PAS < prev    next >
Pascal/Delphi Source File  |  1991-02-10  |  13KB  |  377 lines
  1. Program Create_Telephone_Labels;
  2.  
  3.   { This demo program written using substantial portions of the   }
  4.   { Technojock Object Toolkit in order to demonstrate how various }
  5.   { objects and their methods can be integrated.                  }
  6.   {                                                               }
  7.   { Copyright 1991 by George Bean                                 }
  8.  
  9. Uses Dos, Crt, Printer,
  10.  
  11.          TOTDATE,
  12.          TOTDIR,
  13.          TOTFAST,
  14.          TOTINPUT,
  15.          TOTIO1,
  16.          TOTIO2,
  17.          TOTIO3,
  18.          TOTLINK,
  19.          TOTLIST,
  20.          TOTLOOK,
  21.          TOTMISC,
  22.          TOTMSG,
  23.          TOTREAL,
  24.          TOTSTR,
  25.          TOTSYS,
  26.          TOTWIN;
  27.  
  28. Var ExitWindow             : PromptOBJ;
  29.     PreviewMsg             : MessageOBJ;
  30.     LabelType, Fmtype      : RadioIOOBJ;
  31.     Manager                : FormOBJ;
  32.     IncludeExten           : CheckIOOBJ;
  33.     Screen1                : ScreenOBJ;
  34.     Result, ExitCode       : tAction;
  35.     Preview, Cancel, Print : Strip3DIOOBJ;
  36.     Keys                   : ControlKeysIOOBJ;
  37.     AmountToPrint          : IntIOOBJ;
  38.     MainPhone,
  39.     FirstPhone, LastPhone,
  40.     FirstExten, LastExten  : PictureIOOBJ;
  41.     FP_Int,     LP_Int,
  42.     FE_Int,     LE_Int,
  43.     CurrentExt, X          : Integer;
  44.  
  45. Procedure DisposeVars;
  46. Begin
  47.   LabelType.Done;
  48.   FmType.Done;
  49.   IncludeExten.Done;
  50.   MainPhone.Done;
  51.   FirstPhone.Done;
  52.   LastPhone.Done;
  53.   FirstExten.Done;
  54.   LastExten.Done;
  55.   Preview.Done;
  56.   Cancel.Done;
  57.   Print.Done;
  58.   Manager.Done;
  59. End;
  60.  
  61. Procedure InitForm;
  62. Begin
  63.   IOTOT^.SetColField(113,7,15,120);
  64.   IOTOT^.SetColLabel(48,62,63,62);
  65.   With LabelType Do
  66.   Begin
  67.     Init(10,9,15,3,'');
  68.     SetID(1);
  69.     AddItem('~S~tandard',83,True);
  70.     AddItem('~D~ID',68,False);
  71.     AddItem('~E~xt Only',69,False);
  72.     SetMessage(19,22,' to point, SPACE BAR to select label type');
  73.   End;
  74.   With MainPhone Do
  75.   Begin
  76.     Init(50,9,'(###) ###-####');
  77.     SetLabel(' ~M~ain Number ');
  78.     SetHotKey(77);
  79.     SetID(2);
  80.     SetActiveStatus(True);
  81.     SetMessage(22,22,'Enter the TEN DIGIT telephone number');
  82.   End;
  83.   Keys.Init;
  84.   With FirstPhone Do
  85.   Begin
  86.     Init(50,11,'(###) ###-####');
  87.     SetLabel('  ~F~irst DID  ');
  88.     SetHotKey(70);
  89.     SetID(3);
  90.     SetMessage(19,22,'Enter the First TEN DIGIT telephone number');
  91.   End;
  92.   With LastPhone Do
  93.   Begin
  94.     Init(50,13,'(###) ###-####');
  95.     SetLabel('   ~L~ast DID  ');
  96.     SetHotKey(76);
  97.     SetID(4);
  98.     SetMessage(19,22,'Enter the Last TEN DIGIT telephone number');
  99.   End;
  100.   With FirstExten Do
  101.   Begin
  102.     Init(50,15,'#####');
  103.     SetLabel('  Firs~t~ Ext  ');
  104.     SetHotKey(84);
  105.     SetID(5);
  106.     SetMessage(23,22,'Enter the FIRST extension to print');
  107.   End;
  108.   With LastExten Do
  109.   Begin
  110.     Init(50,17,'#####');
  111.     SetLabel('   L~a~st Ext  ');
  112.     SetHotKey(65);
  113.     SetID(6);
  114.     SetMessage(23,22,'Enter the LAST extension to print');
  115.   End;
  116.   With IncludeExten Do
  117.   Begin
  118.     Init(10,13,15,1,'');
  119.     SetID(7);
  120.     AddItem('~I~nclude Ext',73,True);
  121.     SetMessage(18,22,'Press SPACE BAR to include extension number');
  122.   End;
  123.   With AmountToPrint Do
  124.   Begin
  125.     Init(21,18,4);
  126.     InitFormat;
  127.     SetMinMax(0,9999);
  128.     SetLabel('  Amount  ');
  129.     SetMessage(20,22,'Enter the number of labels to be printed');
  130.   End;
  131.   With FmType Do
  132.   Begin
  133.     Init(10,15,15,3,'');
  134.     AddItem('Ext ~O~ver',79,False);
  135.     AddItem('Ext ~U~nder',85,True);
  136.     SetMessage(18,22,' to point, SPACE BAR to select label format');
  137.   End;
  138.   Preview.Init(24,20,' Pre~v~iew ',Stop1);
  139.   Preview.SetHotkey(86);
  140.   Print.Init(37,20,' ~P~rint ',Finished);
  141.   Print.SetHotkey(80);
  142.   Cancel.Init(48,20,' ~C~ancel ',Escaped);
  143.   Cancel.SetHotkey(67);
  144. End;
  145.  
  146. Procedure DoMenuSelection;
  147. Begin
  148.   With Manager Do
  149.   Begin
  150.     Init;
  151.     Screen.ShadFillBox(5,7,75,23,78,2);
  152.     Screen.WriteBetween(5,75,7,79,'  L A B E L    D E S C R I P T I O N  ');
  153.     AddItem(LabelType);
  154.     AddItem(IncludeExten);
  155.     AddItem(MainPhone);
  156.     AddItem(FirstPhone);
  157.     AddItem(LastPhone);
  158.     AddItem(FirstExten);
  159.     AddItem(LastExten);
  160.     AddItem(FmType);
  161.     AddItem(AmountToPrint);
  162.     AddItem(Preview);
  163.     AddItem(Print);
  164.     AddItem(Cancel);
  165.     AddItem(Keys);
  166.     Result := Go;
  167.   End;
  168. End;
  169.  
  170. Procedure PrintLabels;
  171. Begin
  172.   Write(LST,#27#71);     { Set LQ mode }
  173.   Case LabelType.GetValue Of
  174.     1 : Begin    { Standard Labels }
  175.           If IncludeExten.GetValue(1) Then
  176.           Begin
  177.             If ( FmType.GetValue = 1 ) Then
  178.             Begin   { Standard with ext over }
  179.               CurrentExt := StrToInt(FirstExten.GetValue);
  180.               Repeat
  181.                 Writeln(LST,'   Ext ',CurrentExt);
  182.                 Writeln(LST,MainPhone.GetPicValue);
  183.                 Writeln(LST);
  184.                 Inc(CurrentExt);
  185.               Until CurrentExt = ( StrToInt(LastExten.GetValue) + 1 );
  186.             End
  187.             Else
  188.             Begin   { Standard with ext under }
  189.               CurrentExt := StrToInt(FirstExten.GetValue);
  190.               Repeat
  191.                 Writeln(LST,MainPhone.GetPicValue);
  192.                 Writeln(LST,'   Ext ',CurrentExt);
  193.                 Writeln(LST);
  194.                 Inc(CurrentExt);
  195.               Until CurrentExt = ( StrToInt(LastExten.GetValue) + 1 );
  196.             End;
  197.           End
  198.           Else     { Did not include extension }
  199.           Begin
  200.             For X := 1 to AmountToPrint.GetValue Do
  201.             Begin
  202.               Writeln(LST,MainPhone.GetPicValue);
  203.               Writeln(LST);
  204.               Writeln(LST);
  205.             End;
  206.           End;
  207.         End;
  208.     2 : Begin      { DID Labels }
  209.           FP_Int := StrToInt(Copy(FirstPhone.GetValue,7,4));
  210.           LP_Int := StrToInt(Copy(LastPhone.GetValue,7,4));
  211.           FE_Int := StrToInt(FirstExten.GetValue);
  212.           LE_Int := StrToInt(LastExten.GetValue);
  213.           If IncludeExten.GetValue(1) Then
  214.           Begin
  215.             If ( FmType.GetValue = 1 ) Then
  216.             Begin   { DID with Ext over }
  217.               For X := FP_Int to LP_Int Do
  218.               Begin
  219.                 Writeln(LST,'   Ext ',FE_Int);
  220.                 Writeln(LST,Copy(FirstPhone.GetPicValue,1,10),X);
  221.                 Writeln(LST);
  222.                 Inc(FE_Int);
  223.               End;
  224.             End
  225.             Else
  226.             Begin   { DID with Ext under }
  227.               For X := FP_Int to LP_Int Do
  228.               Begin
  229.                 Writeln(LST,Copy(FirstPhone.GetPicValue,1,10),X);
  230.                 Writeln(LST,'   Ext ',FE_Int);
  231.                 Writeln(LST);
  232.                 Inc(FE_Int);
  233.               End;
  234.             End;
  235.           End
  236.           Else
  237.           Begin
  238.             For X := FP_Int to LP_Int Do
  239.             Begin
  240.               Writeln(LST,Copy(FirstPhone.GetPicValue,1,10),X);
  241.               Writeln(LST);
  242.               Writeln(LST);
  243.             End;
  244.           End;
  245.         End;
  246.     3 : Begin      { Extension Only }
  247.           FE_Int := StrToInt(FirstExten.GetValue);
  248.           LE_Int := StrToInt(LastExten.GetValue);
  249.           For X := FE_Int to LE_Int Do
  250.           Begin
  251.             Writeln(LST,'   Ext ',X);
  252.             Writeln(LST);
  253.             Writeln(LST);
  254.           End;
  255.         End;
  256.   End; { Case }
  257.   Write(LST,#27#72);  { Cancel LQ mode }
  258. End;
  259.  
  260. Begin
  261.   Screen.Clear(3,'▓');
  262.   LookTOT^.SetWindow(31,23,30,30);
  263.   ShadowTOT^.SetShadowStyle(DownRight,7,'░');
  264.   Screen.ShadFillBox(5,2,75,4,31,4);
  265.   Screen.WriteBetween(5,75,3,30,'T E L E P H O N E      L A B E L      D E S I G N E R');
  266.   InitForm;
  267.   Repeat
  268.     DoMenuSelection;
  269.     Case Result Of
  270.       Finished : Begin     { OK to Print }
  271.                    PrintLabels;
  272.                  End;
  273.       Stop1    : Begin     { Preview first and last label }
  274.                    Screen1.Init;
  275.                    Screen1.Save;
  276.                    Screen.PartClear(5,7,77,24,3,'▓');
  277.                    If ( LabelType.GetValue = 3 ) Then   { Extension Only }
  278.                    Begin
  279.                      Screen.ShadFillBox(14,8,31,10,78,1);
  280.                      Screen.ShadFillBox(50,8,67,10,78,1);
  281.                    End
  282.                    Else
  283.                    If IncludeExten.GetValue(1) Then  { Yes, Include Extension }
  284.                    Begin
  285.                      Screen.ShadFillBox(14,8,31,11,78,1);
  286.                      Screen.ShadFillBox(50,8,67,11,78,1);
  287.                    End
  288.                    Else                              { No, Exclude Extension }
  289.                    Begin
  290.                      Screen.ShadFillBox(14,8,31,10,78,1);
  291.                      Screen.ShadFillBox(50,8,67,10,78,1);
  292.                    End;
  293.                    Case LabelType.GetValue Of
  294.                      1 : Begin    { Standard Labels }
  295.                            If IncludeExten.GetValue(1) Then
  296.                            Begin
  297.                              If ( FmType.GetValue = 1 ) Then
  298.                              Begin
  299.                                Screen.WriteAT(19,9,79,'Ext '+FirstExten.GetValue);
  300.                                Screen.WriteAT(55,9,79,'Ext '+LastExten.GetValue);
  301.                                Screen.WriteAT(16,10,79,MainPhone.GetPicValue);
  302.                                Screen.WriteAT(52,10,79,MainPhone.GetPicValue);
  303.                              End
  304.                              Else
  305.                              Begin
  306.                                Screen.WriteAT(16,9,79,MainPhone.GetPicValue);
  307.                                Screen.WriteAT(52,9,79,MainPhone.GetPicValue);
  308.                                Screen.WriteAT(19,10,79,'Ext '+FirstExten.GetValue);
  309.                                Screen.WriteAT(55,10,79,'Ext '+LastExten.GetValue);
  310.                              End;
  311.                            End
  312.                            Else     { Did not include extension }
  313.                            Begin
  314.                              Screen.WriteAT(16,9,79,MainPhone.GetPicValue);
  315.                              Screen.WriteAT(52,9,79,MainPhone.GetPicValue);
  316.                            End;
  317.                          End;
  318.                      2 : Begin      { DID Labels }
  319.                            If IncludeExten.GetValue(1) Then
  320.                            Begin
  321.                              If ( FmType.GetValue = 1 ) Then
  322.                              Begin
  323.                                Screen.WriteAT(19,9,79,'Ext '+FirstExten.GetValue);
  324.                                Screen.WriteAT(55,9,79,'Ext '+LastExten.GetValue);
  325.                                Screen.WriteAT(16,10,79,FirstPhone.GetPicValue);
  326.                                Screen.WriteAT(52,10,79,LastPhone.GetPicValue);
  327.                              End
  328.                              Else
  329.                              Begin
  330.                                Screen.WriteAT(16,9,79,FirstPhone.GetPicValue);
  331.                                Screen.WriteAT(52,9,79,LastPhone.GetPicValue);
  332.                                Screen.WriteAT(19,10,79,'Ext '+FirstExten.GetValue);
  333.                                Screen.WriteAT(55,10,79,'Ext '+LastExten.GetValue);
  334.                              End;
  335.                            End
  336.                            Else
  337.                            Begin
  338.                              Screen.WriteAT(16,9,79,FirstPhone.GetPicValue);
  339.                              Screen.WriteAT(52,9,79,LastPhone.GetPicValue);
  340.                            End;
  341.                          End;
  342.                      3 : Begin      { Extension Only }
  343.                            Screen.WriteAT(19,9,79,'Ext '+FirstExten.GetValue);
  344.                            Screen.WriteAT(55,9,79,'Ext '+LastExten.GetValue);
  345.                          End;
  346.                    End; { Case }
  347.                    Screen.ShadFillBox(25,15,55,20,78,1);
  348.                    Screen.WriteAT(27,16,71,'These labels represent the');
  349.                    Screen.WriteAT(27,17,71,'first and last labels that');
  350.                    Screen.WriteAT(27,18,71,'will be printed......');
  351.                    Screen.WriteAT(30,20,79,' ENTER to continue. ');
  352.                    Readln;
  353.                    Screen1.Display;
  354.                    Screen1.Done;
  355.                  End;
  356.       Escaped  : Begin     { Terminate program }
  357.                    With ExitWindow Do
  358.                    Begin
  359.                      Init(1,' A L E R T ');
  360.                      AddLine('');
  361.                      AddLine(' You have chosen to leave the ');
  362.                      AddLine('   Telephone Label Designer');
  363.                      AddLine('');
  364.                      AddLine('        Please confirm');
  365.                      AddLine('');
  366.                      SetOption(1,' ~P~roceed ',80,Finished);
  367.                      SetOption(2,' ~A~bort ',65,Escaped);
  368.                      ExitCode := Show;
  369.                      Done;
  370.                    End;
  371.                  End;
  372.     End;  { Case of Result }
  373.   Until ExitCode = Finished;
  374.   DisposeVars;
  375.   Clrscr;
  376. End.
  377.